home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pcpm.arc / CPASUBS.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-04  |  5.0 KB  |  165 lines
  1. 90  REM ****  CPASUBS  ****
  2. 92  CLOSE
  3. 93  T1$="Project: \                                                 \ File: \          \"
  4. 94  T2$="Time Period Units: \             \    Subcontractors: ##     Start Date: \    \"
  5. 95  W6$="## \      \ ## \      \ ## \      \"
  6. 110  DEFINT B-Z:DEFSNG A
  7. 112  DIM X$(12),R6$(500)
  8. 114  FOR I=1 TO 12
  9. 116  READ X$(I)
  10. 118  NEXT I
  11. 120  DATA "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
  12. 122  DIM S(500),F(500),D$(500),D(500),O2(500)
  13. 124  DIM A(1500),A3(100),B(500),S$(48),EF(500),ES(500),LS(500),LF(500)
  14. 128  B4=VAL(MID$(DATE$,1,2))
  15. 130  B5=VAL(MID$(DATE$,4,2))
  16. 132  B6=VAL(MID$(DATE$,9,2))
  17. 150  GOSUB 5000  'READ INPUT FILE
  18. 200  GOSUB 9000  'READ SORT FILE
  19. 300  GOSUB 4800  'READ SUBCONTRACTOR FILE
  20. 320  GOSUB 8000  'ReAD HOLIDAY FILE
  21. 350  PRINT "**** FIGURING DAYS - SHOULD TAKE";INT(C3/6);"SECONDS IN REGULAR BASIC ****"
  22. 400  GOSUB 7000 'FIGURE DAYS WITH MESSAGE
  23. 500  GOSUB 5500:GOSUB 6000    'SET UP SCREEN WITH CODES
  24. 600  LOCATE 5,1:INPUT "Enter Subcontractor code (0 to exit) ";C
  25. 610  IF C=0 THEN CLS:CHAIN "CPAMENU"
  26. 620  IF C>NSBC THEN BEEP:GOTO 600
  27. 630  K$=LEFT$(S$(C),3)
  28. 640  IF K$="SBC" OR K$="HOL" OR K$="CPM" THEN K$=LEFT$(K$,2)+"Z"
  29. 700  H$=F$+"."+K$
  30. 710  LOCATE 7,1:PRINT "Output File is ";H$;" O.K.(Y/N) ";:INPUT Q$
  31. 720  IF LEFT$(Q$,1)<>"N" THEN 750
  32. 730  LOCATE 9,1:INPUT "Enter new output filename ";H$
  33. 740  REM GOSUB 10000  'TEST FILE NAME
  34. 750  OPEN H$ FOR OUTPUT AS #2
  35. 1250  IF LEN(P$)>60 THEN P1$=LEFT$(P$,60) ELSE P1$=P$
  36. 1260  T4=INT((118-52-LEN(P1$))/2)
  37. 1270  PRINT #2,TAB(T4);"CRITICAL PATH ANALYSIS FOR: ";P1$;" RUN DATE: ";X$(B4);B5;", 19";RIGHT$(STR$(B6),2)
  38. 1280  PRINT #2,G9$
  39. 1290  T4=((120-15-LEN(T6$))/2)
  40. 1300  PRINT #2,TAB(T4);"TIME PERIOD = ";T6$
  41. 1310  PRINT #2,G9$
  42. 1320  W4$=" DESCRIPTION                     "
  43. 1330  W$="ACTIVITY"+W4$+"FROM   TO  EST. ACTUAL  EARLY    LAST     EARLY    LAST  FLOAT C REPORT  SUBCONTRACTOR"
  44. 1340  W1$="NODE  NODE TIME  TIME   START    START    FINISH  FINISH  TIME P FINISH      NAME"
  45. 1350  PRINT #2,W$
  46. 1360  PRINT #2,TAB(42);W1$
  47. 1370  PRINT #2,G9$
  48. 1380  S4$="\                                      \"
  49. 1390  S5$=" \     \  \     \ "
  50. 1400  S$=S4$+" #### #### ####  ####  "+S5$+S5$+"#### ! \     \ \          \"
  51. 1410  S1$=S4$+" , #### , #### , #### , #### , #### , #### , #### , #### , #### , \     \ , ## "
  52. 1420  FOR I=1 TO N
  53. 1430  IF B(I)<>C THEN 1690   'SORT BY SUBCONTRACTOR
  54. 1440  IF T7=1 THEN A7=LF(I)+1 ELSE A7=A(LF(I)+1)
  55. 1460  GOSUB 7550
  56. 1470  R4$=P6$
  57. 1480  IF T7=1 THEN A7=ES(I)+1 ELSE A7=A(ES(I)+1)
  58. 1500  GOSUB 7550
  59. 1510  R1$=P6$
  60. 1520  IF T7=1 THEN A7=LS(I)+1 ELSE A7=A(LS(I)+1)
  61. 1540  GOSUB 7550
  62. 1550  R2$=P6$
  63. 1560  IF T7=1 THEN A7=EF(I)+1 ELSE A7=A(EF(I)+1)
  64. 1580  GOSUB 7550
  65. 1590  R3$=P6$
  66. 1650  IF R6$(I)="0" THEN R6$(I)=" "
  67. 1660  IF LS(I)-ES(I)=0 THEN G1$="*" ELSE G1$=" "
  68. 1670  PRINT #2,USING S$;D$(I),S(I),F(I),O2(I),D(I),R1$,R2$,R3$,R4$,LS(I)-ES(I),G1$,R6$(I),S$(B(I))
  69. 1690  NEXT I
  70. 1700  CLOSE #2
  71. 1710  LOCATE 9,1:PRINT "**** ";H$;" CREATED ****"
  72. 1712  FOR KR=1 TO 750:KR$="KRISTY":NEXT
  73. 1714  LOCATE 7,1:PRINT SPACE$(40):LOCATE 9,1:PRINT SPACE$(35)
  74. 1716  LOCATE 5,40:PRINT "    "
  75. 1718  GOTO 600
  76. 4800  ON ERROR GOTO 4900
  77. 4805  OPEN F$+".SBC" FOR INPUT AS #1
  78. 4810  I=0
  79. 4820  I=I+1
  80. 4830  IF EOF(1) THEN 4860
  81. 4840  INPUT #1,S$(I)
  82. 4850  GOTO 4820
  83. 4860  PRINT "**** FILE ";F$;".SBC READ -";I-1;"SUBCONTRACTORS READ ****"
  84. 4865  NSBC=I-1
  85. 4870  CLOSE #1:RETURN
  86. 4900  PRINT "**** NO SUBCONTRACTOR FILE - CONTINUING ****":NSBC=0:RESUME 4870
  87. 5000  REM **** READING IN ALREADY CREATED INPUT FILE ******************
  88. 5010  INPUT "Enter the name of the input file [.CPM] ";G$
  89. 5015  IF G$="Q" OR G$="QUIT" THEN CHAIN "CPAMENU"
  90. 5020  P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
  91. 5030  IF LEN(F$)>8 THEN PRINT "**** NOT A VALID PCPM FILE ****":BEEP:GOTO 5010
  92. 5035  ON ERROR GOTO 5300
  93. 5037  G$=F$+".CPM"
  94. 5040  OPEN G$ FOR INPUT AS #3
  95. 5050  INPUT #3,P$,T6$,DA$
  96. 5150  CLOSE #3
  97. 5160  PRINT " **** INPUT FILE READ ****"
  98. 5170  RETURN
  99. 5300  PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****":BEEP:RESUME 5000
  100. 5500  CLS:COLOR 15,0,0:PRINT USING T1$;P$,G$:PRINT USING T2$;T6$,NSBC,DA$:COLOR 7,0,0:RETURN
  101. 6000  REM PRINT SUBCONTRACTOR CODES TO RIGHT OF INPUT SCREEN
  102. 6005  LOCATE 4,49:COLOR 15,0:PRINT "SUBCONTRACTOR/COMMENT CODES":COLOR 7,0
  103. 6010  FOR I=1 TO 16:LOCATE I+4,44:PRINT USING W6$;I,S$(I),I+16,S$(I+16),I+32,S$(I+32):NEXT I
  104. 6020  RETURN
  105. 7000  REM ** CREATE ARRAY OF MMDDYYS ******************************
  106. 7010  REM IF A(1)=0 THEN A(1)=M6*10000+D6*100+Y6
  107. 7020  D1=D1+1
  108. 7030  IF D1>C3+1 THEN RETURN
  109. 7040  A8=A8+1
  110. 7050  GOSUB 7130
  111. 7060  IF LEFT$(T6$,3)="CAL" THEN 7070 ELSE IF D4=6 OR D4=7 THEN 7040
  112. 7070  O8=0
  113. 7080  GOSUB 7240
  114. 7090  IF O8=1 THEN 7040
  115. 7100  A(D1)=M5*10000+D5*100+Y5
  116. 7110  GOTO 7020
  117. 7120  REM ** CONVERT CENTURY DAY TO MM, DD, YY **************************
  118. 7130  T9=INT(A8/1461)
  119. 7140  Y5=INT((A8-T9+364)/365)
  120. 7150  Y4=A8-INT((Y5-1)*1461/4)
  121. 7160  L8=2
  122. 7170  IF Y5/4=INT(Y5/4) THEN L8=1
  123. 7180  T9=Y4
  124. 7190  IF T9>61-L8 THEN T9=T9+L8
  125. 7200  M5=INT((T9*9+269)/275)
  126. 7210  D5=T9-INT(M5*275/9)+30
  127. 7220  D4=A8-INT(A8/7)*7+1
  128. 7230  RETURN
  129. 7240  FOR J=1 TO H9   '**** HOLIDAY OR NOT ***********************************
  130. 7250  IF A8=A3(J) THEN O8=1
  131. 7260  NEXT J
  132. 7270  RETURN
  133. 7550  P6$=STR$(A7)
  134. 7560  IF T7=1 THEN 7600
  135. 7570  IF LEN(P6$)=6 THEN P6$=" "+P6$
  136. 7580  U9=VAL(LEFT$(P6$,3))
  137. 7590  P6$=X$(U9)+RIGHT$(P6$,4)
  138. 7600  RETURN
  139. 8000  ON ERROR GOTO 8200
  140. 8010  OPEN F$+".HOL" FOR INPUT AS #1
  141. 8020  J=0
  142. 8030  J=J+1
  143. 8040  IF EOF(1) THEN 8100
  144. 8050  INPUT #1,A3(J)
  145. 8060  GOTO 8030
  146. 8100  H9=J-1  'NUMBER OF HOLIDAYS
  147. 8110  CLOSE #1:RETURN
  148. 8200  PRINT "**** NO HOLIDAY FILE - CONTINUING ****":RESUME 8110
  149. 9000  REM READING IN SORT FILE
  150. 9010  ON ERROR GOTO 9200    'NO SORT FILE
  151. 9020  OPEN F$+".LGS" FOR INPUT AS #1
  152. 9030  INPUT #1,A8,A(1),C3
  153. 9040  I=0
  154. 9050  I=I+1
  155. 9060  IF EOF(1) THEN 9100
  156. 9070  INPUT #1,D$(I),S(I),F(I),O2(I),D(I),ES(I),LS(I),EF(I),LF(I),FL,R6$(I),B(I)
  157. 9075  IF I MOD 10=0 THEN PRINT I;
  158. 9080  GOTO 9050
  159. 9100  N=I-1
  160. 9105  PRINT "**** LGS FILE READ ****"
  161. 9110  CLOSE #1:RETURN
  162. 9200  PRINT "FILE ";F$;".LGS MUST BE CREATED BY OPTION 5 FIRST AND EXIST ON DISK****":BEEP:CHAIN "CPAMENU"
  163. 10000  REM test file name
  164. 10010  RETURN
  165.